
package Sgdb::Cntr::SymbolLookup ;
use Sgdb::Utils qw( :DEFAULT
                    bind_search_mechanism
                    bind_history_mechanism
                    localconfig
                    ) ;

# pragmas for all
use warnings ;
use strict ;
use integer ;
use bytes ;

# Note: no globals allowed here for future multi interface option

init() ;

sub init { 1 }

sub new {

    my $self = shift or die "whoami" ;
    my $topf = shift or die "top frame needed" ;

    my $text = ( pref ('symbols-lookup-show-scrollbars') ?
                 $topf -> Scrolled ( 'ROText', pref 'symbols-lookup-text' ) :
                 $topf ->             ROText ( pref 'symbols-lookup-text' ) ) ;

    balloonset $text =><<DoC ;
These tables contain datails about results
of your symbol lookup. Right-click to 
edit, copy, or search these data.
DoC
    pref_tags $text, 'symbol-lookup', qw/title lookup/;
    { # menu
        my $m = $text -> menu() ;
        $m -> delete( 0 ) ;
        $m -> add ( 'separator' ) ;
        $m -> add ( 'command', -label => 'clear', -command => [$text, 'delete', '1.0', 'end']) ;
        $m -> add ( 'separator' ) ;
        $m -> add ( 'command', -label => 'close', -command => [\&hook_run, 'close-current-data-pane']) ;
    }

    $text -> bind ("<Meta-Up>"   =>  sub {}) ;
    $text -> bind ("<Meta-Down>" =>  sub {}) ;

    my $lookup ;
    my $e = $topf -> Entry ( -textvariable => \$lookup,
                             pref 'symbols-lookup-entry'
                             ) -> pack ( -side => 'top',
                                         -fill => 'x',
                                         -anchor => 'sw',
#                                         -expand => 1
                                         ) ;


    balloonset $e => <<DoC ;
Enter a symbol or a hex address.
When the address cannot be 
matched exactly, the symbol 
with the closest address is 
shown. Examples: 0023fa9c, 
build_raid_drive_task, 
error_buffer.
DoC

    my $hcb = bind_history_mechanism ( $e, \$lookup ) ;

    $e -> bind ("<Return>" => [\&symbol_lookup,     $text, $hcb, \$lookup]) ;
    hook_add 'symbol-lookup', [\&symbol_lookup, $e, $text, $hcb          ]  ;

    bind_search_mechanism  $text, $e  ;

    pref_reconfigure ( 'symbols-lookup-text' => $text ,
                       'symbols-lookup-entry' => $e
                       ) ;

    $e -> focus ()  ;

    $text ;
}

sub symbol_lookup {

    my ($symfile, $readelf) ;

    return telthemloud 'No Active Debugger' unless            gdb_cached 'is-alive' ;
    return telthemloud 'No Symbol File'     unless $symfile = gdb_cached 'file' ;
    return telthemloud 'No readelf file'    unless $readelf = localconfig 'readelf' ;

    my ($e, $t, $hcb, $ref ) = @_ ;
    my $sym ;

    if (ref $ref ) { $sym = $$ref ; $$ref = '' }
    else           { $sym =  $ref || '' }

    $sym =~ s/^\s+// ;
    $sym =~ s/\s+$// ;
    $sym or return   ;
    $hcb -> ( $sym ) ;

    open FILE, "$readelf -s $symfile |" or return telthemloud "can't execute readelf: $!" ;

    busy ;

#    $t -> delete ( '1.0' => 'end' ) ;
    $t -> markSet("slook", "1.0");
    $t -> insert ( 'slook' => "looking for $sym\n" => 'lookup' ) ;

    while (my $line = <FILE>) {

        $line =~ /^\s*\d/  and last ;
        $line =~ /^\s*Num/ or  next ;
        $t -> insert ( 'slook', $line => 'title' ) ;
        last ;
    }

    if ( $sym =~ /^0x[\da-f]+$/gi or $sym =~ /^\d[\da-f]+$/gi ) {

        $sym = hex $sym ;
        my ($top, @lines ) = (0, 'None') ;

        foreach my $line (<FILE>) {

            if ( $line =~ /^\s*\d+:\s*([\da-f]+)/ ) {

                my $num = hex $1 ;
                if    ( $num <= $sym and $num > $top ) {

                    ($top, @lines) = ($num, $line) ;
                }
                elsif ( $num == $top ) {

                    push @lines, $line ;
                }
            }
            else {

                $t -> insert ( 'slook', $line => 'title' ) ;
            }
        }
        $t -> insert ( 'slook', join '', @lines ) ;
    }
    else {

        if ( my $qr =  eval { qr/\b$sym\s*$/ } ) {

            foreach my $line (<FILE>) {

                $t -> insert ( 'slook', $line ) if $line =~ $qr ;
            }
        }
        else {
            my $err = $@ ;
            $err =~ s/in .*$// ;
            chomp $err ;
            telthemloud "bad regexp: $err" ;
        }
    }
    close FILE ;
    $t -> insert ( 'slook', "\n" )  ;
    unbusy ;
}
